﻿module WingBeats.CSS.SelectorParsing

module Ast =
    
    type combinator =
        | Descendant
        | Child 
        | DirectAdjacent
        | IndirectAdjacent
    
    type attributeSelectorType =
        | ValueIrrelevant           // ex input[selected]
        | ValueIs       of string   // ex a[href=http://www.google.com]
        | OneInListIs   of string   // ex div[class~=main-class]
        | LangCodeValue of string   // ex link[hreflang|=en]
        | BeginsWith    of string   // ex a[href^=http://]
        | EndsWith      of string   // ex a[href$=.com]
        | Contains      of string   // ex a[href*=google]

    type attributeNameSpace =
        | AllNameSpaces
        | NameSpace of string

    type pseudoClass =
        | DynamicPseudoClass of string // ex a:visited, a:hover
        | TargetPseudoClass            // div:target
        | LangPseudoClass    of string // html:lang(fr-be)
        | EnabledPseudoClass
        | DisabledPseudoClass
        | CheckedPseudoClass
        | IndeterminatePseudoClass
        | RootPseudoClass
        | NthChildPseudoClass      of string // Very complicated... needs some thinking...
        | NthLastChildPseudoClass  of string // Same as above... in a future release, like 0.9 or something.. 
        | NthOfTypePseudoClass     of string // Pjuh... complicated
        | NthLastOfTypePseudoClass of string // ...
        | FirstChildPseudoClass
        | LastChildPseudoClass
        | FirstOfTypePseudoClass of string
        | LastOfTypePseudoClass  of string
        | OnlyChildPseudoClass
        | OnlyOfTypePseudoClass  of string
        | EmptyPseudoClass
        | ContainsPseudoClass of string
        | NegationPseudoClass of selector

    and selectorPart =
        | Universal
        | Type          of string
        | ID            of string
        | Class         of string
        | PseudoClass   of pseudoClass
        | PseudoElement of string
        | Attribute     of attributeNameSpace*string*attributeSelectorType
        
    and selector = | Selector         of selector list
                   | Combinator       of combinator
                   | SimpleSelector   of selectorPart list   
                          
    type selectorsGroup = | SelectorsGroup of selector list

    type unparsedSelector = UnparsedSelector of string

module Language =
    open System
    open System.Text.RegularExpressions 
    
    let private matchRegEx pattern s =
        Regex.Match(s, pattern |> sprintf "\A(%s)((?s).*)", 
           RegexOptions.Multiline)
        |> fun mtch ->
            if mtch.Success then
                (mtch.Groups.[1].Value, mtch.Groups.[2].Value) |> Some
            else
                None
    
    let private matchToken input (func : string*string -> 'a option) pattern =
        input |> matchRegEx pattern |> Option.bind func
    
    let private f input union pattern =
        pattern |> matchToken input (fun (s, rest) -> (union s, rest) |> Some)
    
    let private identifierStart = "[a-zA-Z_]"
    let private identifierRest  = "[a-zA-Z0-9-_]"
    let private identifier      = sprintf "%s%s*" identifierStart identifierRest
    
    let private (|SIMPLE_SELECTOR|_|) s =
    
        let (|UNIVERSAL|_|) s =
            "\s*\*\s*" |> f s (fun str -> Ast.Universal)
            
        let (|TYPE|_|) s =
            identifier |> f s (fun str -> Ast.Type str)
            
        let (|ID|_|) s =
            "#" + identifier |> f s (fun str -> Ast.ID (str.Replace("#", "")) )
        
        let (|CLASS|_|) s =
            "\." + identifier |> f s (fun str -> Ast.Class (str.Replace(".", "")) )
        
        let (|PSEUDO_CLASS|_|) s =
            ":" + identifier 
            |> f s (fun str -> 
                Ast.PseudoClass (
                    failwith "(|PSEUDO_CLASS|_|) not implemented"
                    ))

        let (|PSEUDO_ELEMENT|_|) s =
            "::" + identifier 
            |> f s (fun str -> 
                Ast.PseudoElement (
                    failwith "(|PSEUDO_ELEMENT|_|) not implemented" //str.Replace("::", "")
                    ))
            
        let (|ATTRIBUTE|_|) s =
            "\[.*\]" 
            |> f s (fun str -> 
                Ast.Attribute (
                    failwith "(|ATTRIBUTE|_|) not implemented" //Ast.AllNameSpaces, "AnAttribute", Ast.ValueIrrelevant
                    ))

        let rec matchSelectorPart input =
            let rec doMatch input =
                match input with
                | UNIVERSAL      (u, rest)
                | TYPE           (u, rest)
                | ID             (u, rest)
                | CLASS          (u, rest) ->
                    let parts, toBe = doMatch rest
                    [u] @ parts, toBe
                | PSEUDO_CLASS   (u, rest)
                | PSEUDO_ELEMENT (u, rest)
                | ATTRIBUTE      (u, rest) -> failwith "Pseudo, PseudoElement and Attribute selectors are not implemented yet." 
                | _                        -> [], input
            doMatch input
            
        let result = matchSelectorPart s
        match result with
        | [], toBe    -> None
        | parts, toBe -> ((Ast.SimpleSelector parts), toBe) |> Some
    
    let private (|COMBINATOR|_|) input =
    
        let (|DESCENDANT|_|) s = 
            "\s+" |> f s (fun str -> Ast.Descendant)
        
        let (|CHILD|_|) s = 
            "\s*>\s*" |> f s (fun str -> Ast.Child)
        
        let (|DIRECT_ADJACENT|_|) s = 
            "\s*\+\s*" |> f s (fun str -> Ast.DirectAdjacent)
        
        let (|INDIRECT_ADJACENT|_|) s = 
            "\s*~\s*" |> f s (fun str -> Ast.IndirectAdjacent)
            
        let matchCombinator input =
            match input with
            | CHILD             (u, rest)               
            | DIRECT_ADJACENT   (u, rest) 
            | INDIRECT_ADJACENT (u, rest)         
            | DESCENDANT        (u, rest) -> (Ast.Combinator u, rest) |> Some          
            | _ -> None
            
        matchCombinator input
    
    let rec private matchSelector input =
        let rec doMatch input =
            match input with
            | SIMPLE_SELECTOR (u, rest) -> [u] @ doMatch rest 
            | COMBINATOR      (u, rest) -> [u] @ doMatch rest
            | ""                        -> []
            | _                         -> failwith (sprintf "Not a simple selector or a combinator: \"%s\"" input)
        doMatch input
    
    let private (|SELECTOR|_|) s =
        "[^,]+" |> f s (fun str -> Ast.Selector (matchSelector str))

    let SimpleSelectorSequenceToAtoms (input: string) =
        let rec doMatch input =
            match input with
            | SIMPLE_SELECTOR (u, rest) -> [u] @ doMatch rest
            | ""                        -> []
            | _                         -> failwith (sprintf "Parse failure: \"%s\" could not be turned into a simple selector" input)
        (doMatch (input.Trim())).Head
    
    let SelectorCollectionToSelectors (input: string) =
        input.Split(',') |> Seq.map (fun str -> str.Trim())
        |> Seq.map (fun str -> Ast.UnparsedSelector str)
        |> Seq.toList

    let SelectorCollectionToAtoms (input: string) =
        let selectors = input.Split(',') |> Seq.map (fun str -> str.Trim())
        
        let doMatch s = 
            match s with
            | SELECTOR (u, rest) -> u
            | _                  -> failwith (sprintf "Parse failure: \"%s\" could not be turned into a selector" input)
        
        let rec validateSelectors ss =
            let rec checkCombinatorPosition parts first =
                match parts with
                | Ast.Combinator _ :: [] -> failwith "A combinator can not be the last part of a selector"
                | head :: tail          ->
                    match head with
                    | Ast.Combinator _ ->
                        if first 
                            then failwith "A combinator can not be the first part of a selector"
                            else head :: checkCombinatorPosition tail false
                    | Ast.Selector _ ->
                        failwith "A selector can not be part of another selector"
                    | Ast.SimpleSelector _ -> head :: checkCombinatorPosition tail false
                | [] -> []
            match ss with
            | Ast.Selector parts :: tail ->
                Ast.Selector (checkCombinatorPosition parts true) :: validateSelectors tail
            | [] -> []
            | Ast.SimpleSelector _ :: rest 
            | Ast.Combinator     _ :: rest -> failwith "Simple selectors must be part of a Selector."
            
        selectors 
        |> Seq.map (fun str -> doMatch str)
        |> Seq.toList 
        |> validateSelectors